perm filename PIX.SAI[PIX,HPM]4 blob
sn#029977 filedate 1973-03-19 generic text, type T, neo UTF8
00100 BEGIN "PIX"
00200
00300 REQUIRE "HELIB[1,3]" LIBRARY;
00400 REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00500 REQUIRE "SOBMAT[SYS,HE]" LOAD_MODULE;
00600 REQUIRE 2000 STRING_SPACE;
00700 REQUIRE "⊂⊃||" DELIMITERS;
00800
00900 DEFINE α=⊂COMMENT⊃, EXT=⊂EXTERNAL⊃, INT=⊂INTEGER⊃, PRO=⊂PROCEDURE⊃,
01000 CRLF=⊂'15&'12⊃, BHEAD(BUF)=⊂(BUF+1) LAND '777777⊃, REF=⊂REFERENCE⊃,
01100 RED=⊂0⊃, BLUE=⊂1⊃, GREEN=⊂2⊃, CLEAR=⊂3⊃;
01200 EXT PRO PICINI(INT CHAN, FILE, EXTEN, PPN;REF BOOLEAN FAIL;INT ARRAY STOR);
01300 EXT PRO PICRD(REF BOOLEAN FAIL; INT ARRAY STOR);
01400 EXT PRO PICWR(INT CHAN, FILE, EXTEN, PPN; REF BOOLEAN FAIL; INT ARRAY STOR);
01500 EXT PRO RELCOR(INT IOWD);
01600 EXT INT PRO GETCOR(INT SIZE);
01700 EXT PRO INP;
01800 EXT INT PRO GIOWD(INT ARRAY BUF);
01900 EXT PRO EYECAL(INT SIZE, FRAM, FLAG; INT ARRAY BUF);
02000 EXT PRO CWHEEL(INT CODE);
02100 EXT PRO TVINN;
02200 EXT PRO PRDUMP;
02300 EXT PRO PORTR;
02400 EXTERNAL PROCEDURE SPWON(INTEGER TIC;REFERENCE INTEGER ADDR);
02500 EXTERNAL PROCEDURE CALLEN;
02600 EXTERNAL PROCEDURE SPWOFF;
02700 EXT INT TVWORD, FLINE, LLINE, RSIDE, LSIDE, TCLIP, BCLIP, PRTBUF,
02800 L1, L2, L3, P1,P2,P3,STATUS,TSERVO,LENS,TVCAM;
02900
03000 SAFE INT ARRAY PNTRS[1:25];
03100 SAFE REAL ARRAY CAMERA_MODEL[1:10,1:3],PPOT0,PPOTD,TPOT0,TPOTD,FPOT0,FPOTD,
03200 MART,SWING,FOC,FOCLEN0,FOCLENG[1:4],DP,P0[1:4,1:3],PP[1:4,1:2];
03300 INT N, LIN, LINN, I, II, III, ANS, TVLENG;
03400 REAL PANPOT, FOCPOT, TILPOT;
03500 LABEL RUSE, LOOP;
03600 STRING STR, INS;
03650 PRELOAD_WITH "R","B","G"; STRING ARRAY CFIRST[1:3];
03700 SAFE INTEGER ARRAY PICALLOC[1:3]; α allocation table for data blocks;
03800 α first we initialize the world;
03900 QUICK_CODE '051000000000 '10,0; END;
04000 INS ← INCHWL;
04100 CLRBUF;
04200 OUTSTR(CRLF&"TYPE ALTMODE TO CHANGE CHANNEL"&CRLF&CRLF&
04210 "TYPE SPACE TO TAKE A PICTURE"&CRLF&CRLF&
04220 "FOR CHAN 51 (THE OLD HAND EYE CAMERA)"&CRLF&
04230 "YOU MAY ALSO TYPE"&CRLF&
04240 " C - TO TAKE A COLOR PICTURE (THREE FILES)"&CRLF&
04250 " R - TO TAKE A PICTURE THROUGH THE RED FILTER"&CRLF&
04260 " B - TO TAKE A BLUE PICTURE"&CRLF&
04270 " G - TO TAKE A GREEN PICTURE"&CRLF);
04300 WHILE LENGTH(INS) ≥ 2 ∧ INS[1 TO 1] ≠ ";" DO INS ← INS[2 TO ∞];
04400 LIN ← IF INS[1 TO 1]=";" THEN CVO(INS[2 TO ∞]) ELSE '15;
04410 LINN ← 1;
04500 LOOP: TVCAM ← IF (LIN LAND 7) = 1 THEN 1 ELSE
04600 IF (LIN LAND 7) = 2 THEN 2 ELSE
04700 IF (LIN LAND 7) = 0 THEN 0 ELSE 3;
04800 START_CODE
04900 LABEL XX1,GOO;
05000 JRST GOO;
05100 XX1: '401400000000 LIN;
05200 GOO: MOVE 1,LINN;
05210 LSH 1,18;
05220 IOR 1,XX1;
05300 CALLI 1,'400070;
05400 SKIP 0;
05500 END;
05600 TCLIP ← 0;
05700 BCLIP ← 7;
05800 PICALLOC[1] ← PICALLOC[2] ← PICALLOC[3] ← PNTRS[1] ← 0;
05900 ARRBLT(PNTRS[2],PNTRS[1],24);
06000 FLINE←'13;
06100 LLINE←'373;
06200 RSIDE←'512;
06300 LSIDE←'13;
06400 TVLENG ← ((RSIDE-LSIDE)/9+1)*(LLINE-FLINE+1);
06500 PICALLOC[1] ← GETCOR(TVLENG);
06600 IF TVCAM = 1 THEN
06700 BEGIN
06800 PICALLOC[2]←GETCOR(TVLENG);
06900 PICALLOC[3]←GETCOR(TVLENG);
07000 END;
07100 OUTSTR("*");
07200 IF (I ← INCHRW) = '175 THEN
07300 BEGIN
07400 OUTSTR("CHANNEL=");
07500 LIN←CVO(INCHWL);
07600 GO TO RUSE;
07700 END ELSE
07710 IF I = '12 THEN
07720 BEGIN
07730 OUTSTR("LINE=");
07740 LINN←CVO(INCHWL);
07750 GO TO RUSE;
07760 END;
07800 I ← IF I > '140 ∧ I < '173 THEN I - '40 ELSE I;
07900 II ← IF I = '103 THEN RED ELSE
08000 IF I = '102 THEN BLUE ELSE
08100 IF I = '107 THEN GREEN ELSE
08200 IF I = '122 THEN RED ELSE CLEAR;
08300 III ← IF I = '103 ∧ TVCAM = 1 THEN GREEN ELSE II;
08500 N ← 0;
08600 FOR I ← II STEP 1 UNTIL III DO
08700 BEGIN EXTERNAL INTEGER IND;
08800 IF TVCAM = 1 THEN
08900 BEGIN
09000 CWHEEL(6);
09100 IF IND ≠ I THEN
09200 BEGIN INTEGER M;
09300 CWHEEL(I);
09400 M ← 12000;
09500 WHILE M ← M - 1 DO;
09600 END;
09700 END;
09800 TVWORD ← PICALLOC[N ← N + 1];
09900 TVINN;
10000 END;
10100 BEGIN "DSKOUT"
10200 INTEGER FILE, PPN, EXTEN, FAIL;
10300 STRING FILOUT;
10400 LABEL LOOP3;
10500 LOOP3: OUTSTR("FILE NAME=");
10600 STR ← INCHWL;
10700 IF LENGTH(STR)≠0 THEN
10800 FOR I ← 1 STEP 1 UNTIL III-II+1 DO
10900 BEGIN
11000 PNTRS[1]←PICALLOC[I];
11100 FILOUT←IF II=III THEN STR ELSE CFIRST[I]&STR;
11200 FILE←CVFIL(FILOUT,EXTEN,PPN);
11300 PICWR(1,FILE,EXTEN,PPN,FAIL,PNTRS);
11400 IF FAIL THEN BEGIN USERERR(0,0,"WRITING OF FILE "
11500 &FILOUT&" FAILED"); GO TO LOOP3;END;
11600 OUTSTR("FILE "&FILOUT&" WRITTEN OUT"&CRLF);
11700 END;
11800 END "DSKOUT";
11900 α return for next picture;
12000
12100 RUSE: FOR I ← 1 STEP 1 UNTIL 3 DO
12200 BEGIN
12300 IF PICALLOC[I] THEN RELCOR(PICALLOC[I]);
12400 PICALLOC[I] ← PNTRS[I] ← 0;
12500 END;
12600 GO TO LOOP;
12700 END;